home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / ranlib / initgn.f < prev    next >
Text File  |  1996-07-19  |  3KB  |  94 lines
  1.       SUBROUTINE initgn(isdtyp)
  2. C**********************************************************************
  3. C
  4. C     SUBROUTINE INITGN(ISDTYP)
  5. C          INIT-ialize current G-e-N-erator
  6. C
  7. C     Reinitializes the state of the current generator
  8. C
  9. C     This is a transcription from Pascal to Fortran of routine
  10. C     Init_Generator from the paper
  11. C
  12. C     L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
  13. C     with Splitting Facilities." ACM Transactions on Mathematical
  14. C     Software, 17:98-111 (1991)
  15. C
  16. C
  17. C                              Arguments
  18. C
  19. C
  20. C     ISDTYP -> The state to which the generator is to be set
  21. C
  22. C          ISDTYP = -1  => sets the seeds to their initial value
  23. C          ISDTYP =  0  => sets the seeds to the first value of
  24. C                          the current block
  25. C          ISDTYP =  1  => sets the seeds to the first value of
  26. C                          the next block
  27. C
  28. C                                   INTEGER ISDTYP
  29. C
  30. C**********************************************************************
  31. C     .. Parameters ..
  32.       INTEGER numg
  33.       PARAMETER (numg=32)
  34. C     ..
  35. C     .. Scalar Arguments ..
  36.       INTEGER isdtyp
  37. C     ..
  38. C     .. Scalars in Common ..
  39.       INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
  40. C     ..
  41. C     .. Arrays in Common ..
  42.       INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
  43.      +        lg2(numg)
  44.       LOGICAL qanti(numg)
  45. C     ..
  46. C     .. Local Scalars ..
  47.       INTEGER g
  48. C     ..
  49. C     .. External Functions ..
  50.       LOGICAL qrgnin
  51.       INTEGER mltmod
  52.       EXTERNAL qrgnin,mltmod
  53. C     ..
  54. C     .. External Subroutines ..
  55.       EXTERNAL getcgn
  56. C     ..
  57. C     .. Common blocks ..
  58.       COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
  59.      +       cg2,qanti
  60. C     ..
  61. C     .. Save statement ..
  62.       SAVE /globe/
  63. C     ..
  64. C     .. Executable Statements ..
  65. C     Abort unless random number generator initialized
  66.       IF (qrgnin()) GO TO 10
  67.       WRITE (*,*) ' INITGN called before random number generator ',
  68.      +  ' initialized -- abort!'
  69.       CALL XSTOPX
  70.      + (' INITGN called before random number generator initialized')
  71.  
  72.    10 CALL getcgn(g)
  73.       IF ((-1).NE. (isdtyp)) GO TO 20
  74.       lg1(g) = ig1(g)
  75.       lg2(g) = ig2(g)
  76.       GO TO 50
  77.  
  78.    20 IF ((0).NE. (isdtyp)) GO TO 30
  79.       CONTINUE
  80.       GO TO 50
  81. C     do nothing
  82.    30 IF ((1).NE. (isdtyp)) GO TO 40
  83.       lg1(g) = mltmod(a1w,lg1(g),m1)
  84.       lg2(g) = mltmod(a2w,lg2(g),m2)
  85.       GO TO 50
  86.  
  87.    40 STOP 'ISDTYP NOT IN RANGE'
  88.  
  89.    50 cg1(g) = lg1(g)
  90.       cg2(g) = lg2(g)
  91.       RETURN
  92.  
  93.       END
  94.